unit subSetSumMakcSolver;

interface

uses  System.Classes,
      System.SysUtils,
      System.Generics.Defaults,
      System.Generics.Collections,
      System.Math;

type
  TUserCodeType = string;
  TUserDataType = integer;
  //
  TCodeDataItem = TPair<TUserCodeType, TUserDataType>;
  TCodeDataList = TDictionary<TUserCodeType, TUserDataType>;
  //
  TListOfCDList = TList<TCodeDataList>;
  //
  TIntegersList = TList<integer>;
  //
  TTempDataList = TDictionary<TUserCodeType, boolean>;

  TValueIDsItem = class(TObject)
  private
    fValueData: TUserDataType;
    fIndexList: TIntegersList;
  public
    function hasIndexMoreThan(const AIndexData: integer): boolean;
  public
    procedure getIndexList(AIndexList: TIntegersList);
    function getValueData: TUserDataType;
  public
    constructor Create(AValueData: TUserDataType; AIndexList: TIntegersList);
  end;

  TValueIDsList = class(TList<TValueIDsItem>)
  public
    function addValueWithIDList(AValueData: TUserDataType; AIndexList: TIntegersList): TValueIDsItem;
  end;

  TSubSetSumMakcSolver = class(TObject)
  private
    class function initValueIDsList(AAllValuesLst: TCodeDataList; AValueIDsList: TValueIDsList): boolean;
    class function fillValueIDsList(AValueIDsList: TValueIDsList; const AValueIndex, AValueLimit: integer): boolean;
  private
    class procedure makeSolution(AAllValuesLst: TCodeDataList; AStepDataInfo: TTempDataList; AStepSolution: TCodeDataList);
    class function getNextValue(ATempDataItem: TTempDataList): boolean;
    class function solutionOkay(AStepSolution: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType): boolean;
  public
    class procedure solveSubSetSum(AAllValuesLst: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType; ASolutionList: TListOfCDList);
  public
    class procedure solveSubSetSum2(AAllValuesLst: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType; ASolutionList: TListOfCDList);
  end;

implementation

{ TSubSetSumMakcSolver }

class function TSubSetSumMakcSolver.fillValueIDsList(AValueIDsList: TValueIDsList; const AValueIndex, AValueLimit: integer): boolean;
var i            : integer;
    thisStepValue: TUserDataType;
    nextValueData: TUserDataType;
    nextIndexList: TIntegersList;
begin
  Result := AValueIndex < AValueLimit;
  if not Result then
    exit;
  //
  thisStepValue := AValueIDsList[AValueIndex].getValueData;
  for i := AValueIndex to AValueIDsList.Count - 1 do begin
    //
    if not AValueIDsList[i].hasIndexMoreThan(AValueIndex) then
      continue;
    //
    nextValueData := AValueIDsList[i].getValueData + thisStepValue;
    nextIndexList := TIntegersList.Create;
    try
      AValueIDsList[i].getIndexList(nextIndexList);
      nextIndexList.Add(AValueIndex);
      //
      AValueIDsList.addValueWithIDList(nextValueData, nextIndexList);
    finally
      nextIndexList.Free;
    end;
  end;
end;

class function TSubSetSumMakcSolver.getNextValue(ATempDataItem: TTempDataList): boolean;
var TempDataKeys: TUserCodeType;
begin
  Result := ATempDataItem.ContainsValue(false);
  if not Result then
    exit;
  //
  for TempDataKeys in ATempDataItem.Keys do
    case ATempDataItem.Items[TempDataKeys] of
      false:  //  "0"
        begin
          ATempDataItem.Items[TempDataKeys] := true;
          exit;
        end;
      true:   //  "1"
        begin
          ATempDataItem.Items[TempDataKeys] := false;
          continue;
        end;
    end;
end;

class function TSubSetSumMakcSolver.initValueIDsList(AAllValuesLst: TCodeDataList; AValueIDsList: TValueIDsList): boolean;
var index2Values: integer;
    codeDataItem: TCodeDataItem;
    valueIDsItem: TValueIDsItem;
    initDataList: TIntegersList;
    sortedValues: TArray<TCodeDataItem>;
begin
  Result := AAllValuesLst.Count > 0;
  if not Result then
    exit;
  //
  sortedValues := AAllValuesLst.ToArray;

  TArray.Sort<TCodeDataItem>(sortedValues, TDelegatedComparer<TCodeDataItem>.Construct(
    function(const Left, Right: TCodeDataItem): Integer
    begin
      Result := Left.Value - Right.Value;
    end)
  );
  //
  index2Values := 0;
  for CodeDataItem in sortedValues do begin
    initDataList := TIntegersList.Create;
    try
      initDataList.Add(index2Values);
      //
      AValueIDsList.addValueWithIDList(codeDataItem.Value, initDataList);
    finally
      initDataList.free;
    end;
    //
    inc(index2Values);
  end;
end;

class procedure TSubSetSumMakcSolver.makeSolution(AAllValuesLst: TCodeDataList; AStepDataInfo: TTempDataList; AStepSolution: TCodeDataList);
var OneValueData: TCodeDataItem;
begin
  for OneValueData in AAllValuesLst do
    if AStepDataInfo.Items[OneValueData.Key] then
      AStepSolution.Add(OneValueData.Key, OneValueData.Value);
end;

class function TSubSetSumMakcSolver.solutionOkay(AStepSolution: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType): boolean;
var oneValue, sumValue: TUserDataType;
begin
  sumValue := 0;
  for oneValue in AStepSolution.Values do
    sumValue := sumValue + oneValue;
  //
  Result := ABS(ATotalsValue - sumValue) <= ADoPrecision;
end;

class procedure TSubSetSumMakcSolver.solveSubSetSum(AAllValuesLst: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType; ASolutionList: TListOfCDList);
var UserCodeData: TUserCodeType;
    TempDataItem: TTempDataList;
    StepSolution: TCodeDataList;
begin
  TempDataItem := TTempDataList.Create;
  try
    for UserCodeData in AAllValuesLst.Keys do
      TempDataItem.Add(UserCodeData, false);
    //
    while getNextValue(TempDataItem) do begin
      StepSolution := TCodeDataList.Create;
      //
      makeSolution(AAllValuesLst, TempDataItem, StepSolution);
      //
      if solutionOkay(StepSolution, ATotalsValue, ADoPrecision) then
        ASolutionList.Add(StepSolution)
      else
        StepSolution.Free;
    end;
  finally
    TempDataItem.Free;
  end;
end;

class procedure TSubSetSumMakcSolver.solveSubSetSum2(AAllValuesLst: TCodeDataList; ATotalsValue, ADoPrecision: TUserDataType; ASolutionList: TListOfCDList);
var valueIDsList: TValueIDsList;
    valueIndex  : integer;
    valueLimit  : integer;
begin
  ValueIDsList := TValueIDsList.Create;
  try
    initValueIDsList(AAllValuesLst, ValueIDsList);
    //
    valueLimit := valueIDsList.Count - 1;
    for valueIndex := 0 to valueLimit do begin
      if not fillValueIDsList(valueIDsList, valueIndex, valueLimit) then
        break;
      //

    end;
  finally
    ValueIDsList.Free;
  end;
end;

{ TValueIDsItem }

constructor TValueIDsItem.Create(AValueData: TUserDataType; AIndexList: TIntegersList);
begin
  fValueData := AValueData;
  fIndexList := TIntegersList.Create;
  fIndexList.AddRange(AIndexList);
end;

procedure TValueIDsItem.getIndexList(AIndexList: TIntegersList);
begin
  AIndexList.AddRange(fIndexList);
end;

function TValueIDsItem.getValueData: TUserDataType;
begin
  Result := fValueData;
end;

function TValueIDsItem.hasIndexMoreThan(const AIndexData: integer): boolean;
var i: integer;
begin
  Result := fIndexList.Count > 0;
  if not Result then
    exit;
  //
  for i in fIndexList do begin
    Result := i > AIndexData;
    if Result then
      exit;
  end;
end;

{ TValueIDsList }

function TValueIDsList.addValueWithIDList(AValueData: TUserDataType; AIndexList: TIntegersList): TValueIDsItem;
var addIndex: integer;
begin
  addIndex := Add( TValueIDsItem.Create(AValueData, AIndexList) );
  //
  Result := Items[addIndex];
end;

end.
